YES 122.354 H-Termination proof of /home/matraf/haskell/eval_FullyBlown_Fast/List.hs
H-Termination of the given Haskell-Program with start terms could successfully be proven:



HASKELL
  ↳ BR

mainModule List
  ((nub :: [Char ->  [Char]) :: [Char ->  [Char])

module List where
  import qualified Maybe
import qualified Prelude

  nub :: Eq a => [a ->  [a]
nub l 
nub' l [] where 
nub' [] _ []
nub' (x : xsls 
 | x `elem` ls = 
nub' xs ls
 | otherwise = 
x : nub' xs (x : ls)


module Maybe where
  import qualified List
import qualified Prelude



Replaced joker patterns by fresh variables and removed binding patterns.

↳ HASKELL
  ↳ BR
HASKELL
      ↳ COR

mainModule List
  ((nub :: [Char ->  [Char]) :: [Char ->  [Char])

module List where
  import qualified Maybe
import qualified Prelude

  nub :: Eq a => [a ->  [a]
nub l 
nub' l [] where 
nub' [] vw []
nub' (x : xsls 
 | x `elem` ls = 
nub' xs ls
 | otherwise = 
x : nub' xs (x : ls)


module Maybe where
  import qualified List
import qualified Prelude



Cond Reductions:
The following Function with conditions
nub' [] vw = []
nub' (x : xsls
 | x `elem` ls
 = nub' xs ls
 | otherwise
 = x : nub' xs (x : ls)

is transformed to
nub' [] vw = nub'3 [] vw
nub' (x : xsls = nub'2 (x : xsls

nub'0 x xs ls True = x : nub' xs (x : ls)

nub'1 x xs ls True = nub' xs ls
nub'1 x xs ls False = nub'0 x xs ls otherwise

nub'2 (x : xsls = nub'1 x xs ls (x `elem` ls)

nub'3 [] vw = []
nub'3 wv ww = nub'2 wv ww

The following Function with conditions
undefined 
 | False
 = undefined

is transformed to
undefined  = undefined1

undefined0 True = undefined

undefined1  = undefined0 False



↳ HASKELL
  ↳ BR
    ↳ HASKELL
      ↳ COR
HASKELL
          ↳ LetRed

mainModule List
  ((nub :: [Char ->  [Char]) :: [Char ->  [Char])

module List where
  import qualified Maybe
import qualified Prelude

  nub :: Eq a => [a ->  [a]
nub l 
nub' l [] where 
nub' [] vw nub'3 [] vw
nub' (x : xsls nub'2 (x : xs) ls
nub'0 x xs ls True x : nub' xs (x : ls)
nub'1 x xs ls True nub' xs ls
nub'1 x xs ls False nub'0 x xs ls otherwise
nub'2 (x : xsls nub'1 x xs ls (x `elem` ls)
nub'3 [] vw []
nub'3 wv ww nub'2 wv ww


module Maybe where
  import qualified List
import qualified Prelude



Let/Where Reductions:
The bindings of the following Let/Where expression
nub' l []
where 
nub' [] vw = nub'3 [] vw
nub' (x : xsls = nub'2 (x : xsls
nub'0 x xs ls True = x : nub' xs (x : ls)
nub'1 x xs ls True = nub' xs ls
nub'1 x xs ls False = nub'0 x xs ls otherwise
nub'2 (x : xsls = nub'1 x xs ls (x `elem` ls)
nub'3 [] vw = []
nub'3 wv ww = nub'2 wv ww

are unpacked to the following functions on top level
nubNub'3 [] vw = []
nubNub'3 wv ww = nubNub'2 wv ww

nubNub' [] vw = nubNub'3 [] vw
nubNub' (x : xsls = nubNub'2 (x : xsls

nubNub'0 x xs ls True = x : nubNub' xs (x : ls)

nubNub'1 x xs ls True = nubNub' xs ls
nubNub'1 x xs ls False = nubNub'0 x xs ls otherwise

nubNub'2 (x : xsls = nubNub'1 x xs ls (x `elem` ls)



↳ HASKELL
  ↳ BR
    ↳ HASKELL
      ↳ COR
        ↳ HASKELL
          ↳ LetRed
HASKELL
              ↳ Narrow

mainModule List
  (nub :: [Char ->  [Char])

module List where
  import qualified Maybe
import qualified Prelude

  nub :: Eq a => [a ->  [a]
nub l nubNub' l []

  
nubNub' [] vw nubNub'3 [] vw
nubNub' (x : xsls nubNub'2 (x : xs) ls

  
nubNub'0 x xs ls True x : nubNub' xs (x : ls)

  
nubNub'1 x xs ls True nubNub' xs ls
nubNub'1 x xs ls False nubNub'0 x xs ls otherwise

  
nubNub'2 (x : xsls nubNub'1 x xs ls (x `elem` ls)

  
nubNub'3 [] vw []
nubNub'3 wv ww nubNub'2 wv ww


module Maybe where
  import qualified List
import qualified Prelude



Haskell To QDPs


↳ HASKELL
  ↳ BR
    ↳ HASKELL
      ↳ COR
        ↳ HASKELL
          ↳ LetRed
            ↳ HASKELL
              ↳ Narrow
                ↳ AND
QDP
                    ↳ DependencyGraphProof
                  ↳ QDP

Q DP problem:
The TRS P consists of the following rules:

new_nubNub'14(Char(Succ(wx320800)), wx3209, :(wx32100, wx32101)) → new_nubNub'15(wx320800, wx3209, :(wx32100, wx32101), wx32100, wx32101)
new_nubNub'17(wx3497, wx3498, wx3499, Zero, Zero, wx3502) → new_nubNub'0(wx3498, wx3499)
new_nubNub'0(:(wx32090, wx32091), wx3210) → new_nubNub'14(wx32090, wx32091, wx3210)
new_nubNub'16(wx31000, :(wx3110, wx3111)) → new_nubNub'11(wx3110, wx3111, wx31000, :(Char(Zero), []))
new_nubNub'13(:(wx3110, wx3111), wx3000) → new_nubNub'14(wx3110, wx3111, :(Char(Succ(wx3000)), []))
new_nubNub'17(wx3497, wx3498, wx3499, Succ(wx35000), Succ(wx35010), wx3502) → new_nubNub'17(wx3497, wx3498, wx3499, wx35000, wx35010, wx3502)
new_nubNub'4(:(wx3110, wx3111), wx3000) → new_nubNub'14(wx3110, wx3111, :(Char(Succ(wx3000)), []))
new_nubNub'1(wx3748, wx3749, wx3750, wx3751, Zero, Succ(wx37530), wx3754) → new_nubNub'10(wx3748, wx3749, wx3750, wx3751, wx3754)
new_nubNub'18(wx3497, :(wx34980, wx34981), wx3499, []) → new_nubNub'11(wx34980, wx34981, wx3497, :(Char(Zero), wx3499))
new_nubNub'17(wx3497, wx3498, wx3499, Succ(wx35000), Zero, :(wx35020, wx35021)) → new_nubNub'15(wx3497, wx3498, wx3499, wx35020, wx35021)
new_nubNub'14(Char(Zero), :(wx32090, wx32091), wx3210) → new_nubNub'14(wx32090, wx32091, wx3210)
new_nubNub'10(wx3748, wx3749, wx3750, wx3751, []) → new_nubNub'(wx3749, wx3748, :(Char(Succ(wx3750)), wx3751))
new_nubNub'(:(wx36090, wx36091), wx3610, wx3611) → new_nubNub'11(wx36090, wx36091, wx3610, wx3611)
new_nubNub'11(Char(Zero), wx3548, wx3549, []) → new_nubNub'13(wx3548, wx3549)
new_nubNub'18(wx3497, wx3498, wx3499, :(wx35020, wx35021)) → new_nubNub'15(wx3497, wx3498, wx3499, wx35020, wx35021)
new_nubNub'2(:(wx34980, wx34981), wx3497, wx3499) → new_nubNub'11(wx34980, wx34981, wx3497, :(Char(Zero), wx3499))
new_nubNub'10(wx3748, wx3749, wx3750, wx3751, :(Char(wx375400), wx37541)) → new_nubNub'1(wx3748, wx3749, wx3750, wx3751, Succ(wx3748), wx375400, wx37541)
new_nubNub'11(Char(Zero), wx3548, wx3549, :(wx35500, wx35501)) → new_nubNub'12(wx3548, wx3549, :(wx35500, wx35501), wx35500, wx35501)
new_nubNub'15(wx3442, wx3443, wx3444, Char(wx34450), wx3446) → new_nubNub'17(wx3442, wx3443, wx3444, Succ(wx3442), wx34450, wx3446)
new_nubNub'17(wx3497, :(wx34980, wx34981), wx3499, Succ(wx35000), Zero, []) → new_nubNub'11(wx34980, wx34981, wx3497, :(Char(Zero), wx3499))
new_nubNub'17(wx3497, wx3498, wx3499, Zero, Succ(wx35010), wx3502) → new_nubNub'18(wx3497, wx3498, wx3499, wx3502)
new_nubNub'1(wx3748, wx3749, wx3750, wx3751, Succ(wx37520), Zero, []) → new_nubNub'(wx3749, wx3748, :(Char(Succ(wx3750)), wx3751))
new_nubNub'14(Char(Succ(wx320800)), wx3209, []) → new_nubNub'16(wx320800, wx3209)
new_nubNub'12(wx3615, wx3616, wx3617, Char(Succ(wx361800)), []) → new_nubNub'0(wx3615, :(Char(Succ(wx3616)), wx3617))
new_nubNub'1(wx3748, wx3749, wx3750, wx3751, Succ(wx37520), Succ(wx37530), wx3754) → new_nubNub'1(wx3748, wx3749, wx3750, wx3751, wx37520, wx37530, wx3754)
new_nubNub'1(wx3748, wx3749, wx3750, wx3751, Succ(wx37520), Zero, :(Char(wx375400), wx37541)) → new_nubNub'1(wx3748, wx3749, wx3750, wx3751, Succ(wx3748), wx375400, wx37541)
new_nubNub'12(wx3615, wx3616, wx3617, Char(Zero), wx3619) → new_nubNub'(wx3615, wx3616, wx3617)
new_nubNub'1(wx3748, wx3749, wx3750, wx3751, Zero, Zero, wx3754) → new_nubNub'(wx3749, wx3750, wx3751)
new_nubNub'3(:(wx3110, wx3111), wx31000) → new_nubNub'11(wx3110, wx3111, wx31000, :(Char(Zero), []))
new_nubNub'11(Char(Succ(wx354700)), wx3548, wx3549, wx3550) → new_nubNub'1(wx354700, wx3548, wx3549, wx3550, wx354700, wx3549, wx3550)
new_nubNub'12(wx3615, wx3616, wx3617, Char(Succ(wx361800)), :(wx36190, wx36191)) → new_nubNub'12(wx3615, wx3616, wx3617, wx36190, wx36191)

R is empty.
Q is empty.
We have to consider all minimal (P,Q,R)-chains.
The approximation of the Dependency Graph [15,17,22] contains 1 SCC with 3 less nodes.

↳ HASKELL
  ↳ BR
    ↳ HASKELL
      ↳ COR
        ↳ HASKELL
          ↳ LetRed
            ↳ HASKELL
              ↳ Narrow
                ↳ AND
                  ↳ QDP
                    ↳ DependencyGraphProof
QDP
                        ↳ QDPSizeChangeProof
                  ↳ QDP

Q DP problem:
The TRS P consists of the following rules:

new_nubNub'14(Char(Succ(wx320800)), wx3209, :(wx32100, wx32101)) → new_nubNub'15(wx320800, wx3209, :(wx32100, wx32101), wx32100, wx32101)
new_nubNub'17(wx3497, wx3498, wx3499, Zero, Zero, wx3502) → new_nubNub'0(wx3498, wx3499)
new_nubNub'16(wx31000, :(wx3110, wx3111)) → new_nubNub'11(wx3110, wx3111, wx31000, :(Char(Zero), []))
new_nubNub'0(:(wx32090, wx32091), wx3210) → new_nubNub'14(wx32090, wx32091, wx3210)
new_nubNub'13(:(wx3110, wx3111), wx3000) → new_nubNub'14(wx3110, wx3111, :(Char(Succ(wx3000)), []))
new_nubNub'17(wx3497, wx3498, wx3499, Succ(wx35000), Succ(wx35010), wx3502) → new_nubNub'17(wx3497, wx3498, wx3499, wx35000, wx35010, wx3502)
new_nubNub'18(wx3497, :(wx34980, wx34981), wx3499, []) → new_nubNub'11(wx34980, wx34981, wx3497, :(Char(Zero), wx3499))
new_nubNub'1(wx3748, wx3749, wx3750, wx3751, Zero, Succ(wx37530), wx3754) → new_nubNub'10(wx3748, wx3749, wx3750, wx3751, wx3754)
new_nubNub'14(Char(Zero), :(wx32090, wx32091), wx3210) → new_nubNub'14(wx32090, wx32091, wx3210)
new_nubNub'17(wx3497, wx3498, wx3499, Succ(wx35000), Zero, :(wx35020, wx35021)) → new_nubNub'15(wx3497, wx3498, wx3499, wx35020, wx35021)
new_nubNub'10(wx3748, wx3749, wx3750, wx3751, []) → new_nubNub'(wx3749, wx3748, :(Char(Succ(wx3750)), wx3751))
new_nubNub'(:(wx36090, wx36091), wx3610, wx3611) → new_nubNub'11(wx36090, wx36091, wx3610, wx3611)
new_nubNub'11(Char(Zero), wx3548, wx3549, []) → new_nubNub'13(wx3548, wx3549)
new_nubNub'18(wx3497, wx3498, wx3499, :(wx35020, wx35021)) → new_nubNub'15(wx3497, wx3498, wx3499, wx35020, wx35021)
new_nubNub'10(wx3748, wx3749, wx3750, wx3751, :(Char(wx375400), wx37541)) → new_nubNub'1(wx3748, wx3749, wx3750, wx3751, Succ(wx3748), wx375400, wx37541)
new_nubNub'11(Char(Zero), wx3548, wx3549, :(wx35500, wx35501)) → new_nubNub'12(wx3548, wx3549, :(wx35500, wx35501), wx35500, wx35501)
new_nubNub'15(wx3442, wx3443, wx3444, Char(wx34450), wx3446) → new_nubNub'17(wx3442, wx3443, wx3444, Succ(wx3442), wx34450, wx3446)
new_nubNub'17(wx3497, :(wx34980, wx34981), wx3499, Succ(wx35000), Zero, []) → new_nubNub'11(wx34980, wx34981, wx3497, :(Char(Zero), wx3499))
new_nubNub'17(wx3497, wx3498, wx3499, Zero, Succ(wx35010), wx3502) → new_nubNub'18(wx3497, wx3498, wx3499, wx3502)
new_nubNub'14(Char(Succ(wx320800)), wx3209, []) → new_nubNub'16(wx320800, wx3209)
new_nubNub'1(wx3748, wx3749, wx3750, wx3751, Succ(wx37520), Zero, []) → new_nubNub'(wx3749, wx3748, :(Char(Succ(wx3750)), wx3751))
new_nubNub'12(wx3615, wx3616, wx3617, Char(Succ(wx361800)), []) → new_nubNub'0(wx3615, :(Char(Succ(wx3616)), wx3617))
new_nubNub'1(wx3748, wx3749, wx3750, wx3751, Succ(wx37520), Succ(wx37530), wx3754) → new_nubNub'1(wx3748, wx3749, wx3750, wx3751, wx37520, wx37530, wx3754)
new_nubNub'1(wx3748, wx3749, wx3750, wx3751, Succ(wx37520), Zero, :(Char(wx375400), wx37541)) → new_nubNub'1(wx3748, wx3749, wx3750, wx3751, Succ(wx3748), wx375400, wx37541)
new_nubNub'12(wx3615, wx3616, wx3617, Char(Zero), wx3619) → new_nubNub'(wx3615, wx3616, wx3617)
new_nubNub'1(wx3748, wx3749, wx3750, wx3751, Zero, Zero, wx3754) → new_nubNub'(wx3749, wx3750, wx3751)
new_nubNub'11(Char(Succ(wx354700)), wx3548, wx3549, wx3550) → new_nubNub'1(wx354700, wx3548, wx3549, wx3550, wx354700, wx3549, wx3550)
new_nubNub'12(wx3615, wx3616, wx3617, Char(Succ(wx361800)), :(wx36190, wx36191)) → new_nubNub'12(wx3615, wx3616, wx3617, wx36190, wx36191)

R is empty.
Q is empty.
We have to consider all minimal (P,Q,R)-chains.
By using the subterm criterion [20] together with the size-change analysis [32] we have proven that there are no infinite chains for this DP problem.

From the DPs we obtained the following set of size-change graphs:



↳ HASKELL
  ↳ BR
    ↳ HASKELL
      ↳ COR
        ↳ HASKELL
          ↳ LetRed
            ↳ HASKELL
              ↳ Narrow
                ↳ AND
                  ↳ QDP
QDP
                    ↳ QDPSizeChangeProof

Q DP problem:
The TRS P consists of the following rules:

new_nubNub'5(:(Char(Zero), wx311), Char(Zero)) → new_nubNub'5(wx311, Char(Zero))

R is empty.
Q is empty.
We have to consider all minimal (P,Q,R)-chains.
By using the subterm criterion [20] together with the size-change analysis [32] we have proven that there are no infinite chains for this DP problem.

From the DPs we obtained the following set of size-change graphs: